REM ***************** TESTPROGRAMM FÜR VEKTORFONHANDLER  *******************

CLEAR

' -------- Libraryfunktionen einbinden -----------
DECLARE FUNCTION FindTask& LIBRARY
DECLARE FUNCTION FindPort& LIBRARY
DECLARE FUNCTION GetMsg& LIBRARY
DECLARE FUNCTION AllocMem& LIBRARY
LIBRARY "exec.library"
DECLARE FUNCTION xOpen& LIBRARY
DECLARE FUNCTION xRead& LIBRARY
LIBRARY "dos.library"

FileName$="df0:VektorFonts/topaz.vek"  : ' Vektorfontfile
OutText$="Beispieltext"                : ' Ausgabetext
ErrVar&=0                              : ' Fehlervariable

WINDOW 2,"Window",(0,0)-(617,180),15   : ' Ausgabefenster oeffnen

CALL LoadVekFont (FileName$)           : ' Vektorfont laden

IF VFontAdr&=0 THEN                   
  PRINT "Nicht genuegend Speicher !"   : ' AllocMem erfolgreich ?
END IF  
h1%=PEEKW(VFontAdr&+4)                 : ' Kennung pruefen
IF (h1% <> &Habcd) THEN
  PRINT "Das ist kein Vektorfontfile !"
  GOTO abbruch
END IF
IF MePort&=0 THEN          
  PRINT "Handler wurde nicht gefunden !"
  GOTO abbruch
  END
END IF

CALL VektorTextOut(10,10,50,50,2,OutText$,0)
CALL VektorTextOut(10,60,100,100,4,OutText$,1)

abbruch:

IF VFontAdr& <> 0 THEN CALL FreeMem(VFontAdr&,VFontLen&)        
IF VMessAdr& <> 0 THEN CALL FreeMem(VMessAdr&,64)             
END

' ********************* Subroutine Vektorfont laden **********************

SUB LoadVekFont (finame$) STATIC
SHARED VFontLen&,VFontAdr&,VMessAdr&,Port1$,Port2$,RePort&,MePort&

  Port1$="vekfport-t0"+CHR$(0)             : ' Portname Messageport
  Port2$="vekfport-t1"+CHR$(0)             : ' Portname ReplyPort
  RePort&=0                                : ' ReplyPort Adresse
  MePort&=0                                : ' MessagePort Adresse
  VMessAdr&=0                              : ' Adresse von struct VFontMess
  VFontLen&=0                              : ' Laenge Fontfile
  VFontAdr&=0                              : ' Startadresse Fontfile

  OPEN finame$ FOR INPUT AS 1              : ' Filelaenge feststellen
  VFontLen&=LOF(1)
  CLOSE #1
  VFontAdr&=AllocMem&(VFontLen&,0)        : ' Speicher fuer Font belegen
  IF VFontAdr&=0 THEN EXIT SUB             : ' Nicht genuegend Speicher ?
  a$=finame$+CHR$(0)                       : ' Filename terminieren
  datei&=xOpen&(SADD(a$),1005)            : ' Datei oeffnen
  IF datei&=0 THEN                            
    PRINT "Datei nicht gefunden !"         : ' 0 - wenn Fehler
  ELSE                                        
    h&=xRead&(datei&,VFontAdr&,VFontLen&)  : ' datei in Speicher laden
    xClose(datei&)                         : ' datei schliessen
    CALL InitPorts                         : ' Messageports installieren
  END IF  
 
END SUB

' *************** Messageports von Handler Task suchen ********************
  
SUB InitPorts STATIC
SHARED RePort&,MePort&,Port1$,Port2$,VMessAdr&,VFontAdr&

  MePort&=FindPort&(SADD(Port1$)) : ' Messageport von Handler suchen
  RePort&=FindPort&(SADD(Port2$)) : ' Replyport suchen
  IF MePort& <> 0 THEN
    h1&=FindTask&(0)             : ' Zeiger auf eigenen Task suchen
    POKEL RePort&+16,h1&          : ' ReplyPort auf eigenen Task setzen
    POKE VMessAdr&+8,5            : ' VMess.ln_Type=NT_MESSAGE (5)
    VMessAdr&=AllocMem&(64,0)   : ' Speicher fuer Message anfordern
    FOR i=0 TO 64 
      POKE VMessAdr&+i,0          : ' Speicher initialisieren
    NEXT i   
    POKEL VMessAdr&+14,RePort&    : ' ReplyPort in Message einbinden
    POKEL VMessAdr&+24,VFontAdr&  : ' Startadresse Fontfile    
  END IF
     
END SUB    

' ***************************** Text ausgeben *****************************

SUB VektorTextOut(x&,y&,wi&,hi&,bspc&,text$,drmd&) STATIC
SHARED VMessAdr&,MePort&,RePort&,FontBuff$,ErrVar&,VFontAdr&                          

  a$=text$+CHR$(0)                    : ' String terminieren
  
  POKEL VMessAdr&+20,WINDOW(8)        : ' Rastport von Ausgabefenster  
  POKEL VMessAdr&+28,x&               : ' X-Koordinate
  POKEL VMessAdr&+32,y&               : ' Y-Koordinate
  POKEL VMessAdr&+36,wi&              : ' Fontbreite
  POKEL VMessAdr&+40,hi&              : ' Fonthoehe
  POKEL VMessAdr&+44,bspc&            : ' Zeichenabstand 
  POKEL VMessAdr&+48,0               : ' Flagvariable auf NULL
  POKEL VMessAdr&+52,SADD(a$)         : ' Startadresse Ausgabetext
  POKEL VMessAdr&+56,LEN(a$)          : ' Laenge des Ausgabetextes
  POKEL VMessAdr&+60,drmd&            : ' Zeichenmodus
  
  CALL PutMsg(MePort&,VMessAdr&)      : ' Message abschicken
  CALL WaitPort(RePort&)              : ' Auf Antwort warten
  h1&=GetMsg&(RePort&)                : ' Antwort abholen
   
  ErrVar&=PEEKL(h1&+48)               : ' Antwort auswerten
  
END SUB